home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 7 / BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso / Files / Prog / H-K / Icon.sample.cpt / animal.icn next >
Text File  |  1987-01-02  |  4KB  |  178 lines
  1. #
  2. #                Animal Game
  3. #                ===========
  4. #
  5. #  This is the familiar "animal game" written in Icon.  The computer
  6. #  will ask its human opponent questions in an attempt to guess
  7. #  what animal he is thinking of.  It is an "expert system" that
  8. #  starts out with limited knowledge, but gets smarter as it plays
  9. #  and learns from its opponents.  At the conclusion of a session,
  10. #  the computer will ask permission to remember for future sessions
  11. #  that which it learned.
  12. #  
  13. #  The game is not limited to guessing animals only.  By simply
  14. #  modifying the first two lines of procedure "main" it will happily
  15. #  guess things in other categories.  For example, the lines:
  16. #
  17. #    GameObject := "president"
  18. #    Tree := Question("Has he ever been known as Bonzo",
  19. #            "Reagan","Lincoln")
  20. #
  21. #  can be substituted and it works reasonably well.  The knowledge files
  22. #  will be kept separate, too.
  23. #
  24. #  Typing "list" at any yes/no prompt will show an inventory of
  25. #  animals known, and there are some other commands (see procedure
  26. #  "Confirm").
  27. #
  28.  
  29. global GameObject,Tree,ShowLine,Learn
  30. record Question(question,yes,no)
  31.  
  32. procedure main()
  33.   GameObject := "animal"
  34.   Tree := Question("Does it live in water","goldfish","canary")
  35.   Get()        # Recall prior knowledge
  36.   Game()    # Play a game
  37.   return
  38. end
  39.  
  40. procedure Game()
  41.   while Confirm("Are you thinking of ",Article(GameObject)," ",
  42.       GameObject) do {
  43.     Ask(Tree)
  44.   }
  45.   write("Thanks for a great game.")
  46.   if \Learn &
  47.       Confirm("Want to save knowledge learned this session") then Save()
  48.   return
  49. end
  50.  
  51. procedure Confirm(q1,q2,q3,q4,q5,q6)
  52.   local answer,s
  53.   static ok
  54.   initial {
  55.     ok := table()
  56.     ok["y"] := ok["yes"] := ok["yeah"] := ok["uh huh"] := "yes"
  57.     ok["n"] := ok["no"] := ok["nope"] := ok["uh uh"] := "no"
  58.   }
  59.   while /answer do {
  60.     write(q1,q2,q3,q4,q5,q6,"?")
  61.     case s := read() | exit(1) of {
  62.       "save": Save()
  63.       "get": Get()
  64.       "list": List()
  65.       "dump": Output(Tree,&output)
  66.       default: {
  67.     (answer := \ok[map(s,&ucase,&lcase)]) |
  68.           write("This is a \"yes\" or \"no\" question.")
  69.       }
  70.     }
  71.   }
  72.   return answer == "yes"
  73. end
  74.  
  75. procedure Ask(node)
  76.   local guess,question
  77.   case type(node) of {
  78.     "string": {
  79.       if not Confirm("It must be ",Article(node)," ",node,", right") then {
  80.         Learn := "yes"
  81.         write("What were you thinking of?")
  82.     guess := read() | exit(1)
  83.     write("What question would distinguish ",Article(guess)," ",
  84.         guess," from ",Article(node)," ",node,"?")
  85.     question := read() | exit(1)
  86.     if question[-1] == "?" then question[-1] := ""
  87.     question[1] := map(question[1],&lcase,&ucase)
  88.     if Confirm("For ",Article(guess)," ",guess,", what would the _
  89.         answer be") then {
  90.       return Question(question,guess,node)
  91.     }
  92.     else {
  93.       return Question(question,node,guess)
  94.     }
  95.       }
  96.     }
  97.     "Question": {
  98.       if Confirm(node.question) then {
  99.         node.yes := Ask(node.yes)
  100.       }
  101.       else {
  102.         node.no := Ask(node.no)
  103.       }
  104.     }
  105.   }
  106. end
  107.  
  108. procedure Article(word)
  109.   return if any('aeiouAEIOU',word) then "an" else "a"
  110. end
  111.  
  112. procedure Save()
  113.   local f
  114.   f := open(GameObject || "s","w")
  115.   Output(Tree,f)
  116.   close(f)
  117.   return
  118. end
  119.  
  120. procedure Output(node,f,sense)
  121.   static indent
  122.   initial indent := 0
  123.   /sense := " "
  124.   case type(node) of {
  125.     "string":  write(f,repl(" ",indent),sense,"A: ",node)
  126.     "Question": {
  127.       write(f,repl(" ",indent),sense,"Q: ", node.question)
  128.       indent +:= 1
  129.       Output(node.yes,f,"y")
  130.       Output(node.no,f,"n")
  131.       indent -:= 1
  132.     }
  133.   }
  134.   return
  135. end
  136.  
  137. procedure Get()
  138.   local f
  139.   f := open(GameObject || "s","r") | fail
  140.   Tree := Input(f)
  141.   close(f)
  142.   return
  143. end
  144.  
  145. procedure Input(f)
  146.   local nodetype,s
  147.   read(f) ? (tab(upto(~' \t')) & =("y" | "n" | "") &
  148.       nodetype := move(1) & move(2) & s := tab(0))
  149.   if nodetype == "Q" then {
  150.     return Question(s,Input(f),Input(f))
  151.   }
  152.   else {
  153.     return s
  154.   }
  155. end
  156.  
  157. procedure List()
  158.   ShowLine := ""
  159.   Show(Tree)
  160.   write(trim(ShowLine))
  161.   return
  162. end
  163.  
  164. procedure Show(node)
  165.   if type(node) == "Question" then {
  166.     Show(node.yes)
  167.     Show(node.no)
  168.   }
  169.   else {
  170.     if *ShowLine + *node > 78 then {
  171.       write(trim(ShowLine))
  172.       ShowLine := ""
  173.     }
  174.     ShowLine ||:= node || "  "
  175.   }
  176.   return
  177. end
  178.